PC World 2007 November/PCWorld_2007-11_cd.bin/domácnost a kancelar/winorganizer/WinOrg.exe/PluginsAndCOM/Plugins/Demo/fComment.pas

Pascal/Delphi Source File | 2005-09-08 | 8.3 KB | 338 lines

unit fComment;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ComObj, ExtCtrls, ImgList, ToolWin;

type
  TfrmComment = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    RichEdit1: TRichEdit;
    ToolBar1: TToolBar;
    btFirst: TToolButton;
    btPrev: TToolButton;
    btNext: TToolButton;
    btLast: TToolButton;
    ImageList1: TImageList;
    PanelTitle: TPanel;
    rgFormat: TRadioGroup;
    btSave: TButton;
    SaveDialog1: TSaveDialog;
    procedure btNavigatorClick(Sender: TObject);
    procedure rgFormatClick(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
    procedure btImportHtml(Sender: TObject);
  private
    { Private declarations }
    FTable: Variant;
    FItemIndex: Integer;
    FTitleIndex: Integer;
    FCommentIndex: Integer;
    procedure UpdateData;
  public
    { Public declarations }
    class procedure Execute;
  end;

var
  frmComment: TfrmComment;

implementation

{$R *.DFM}

{ TfrmComment }

class procedure TfrmComment.Execute;
var
  WOrg, ADoc: Variant;
begin
  WOrg := CreateOLEObject('WinOrganizer.App');
  Application.Handle := WOrg.Handle;

  with TfrmComment.Create(Application) do
  try
    if WOrg.FileList.ActiveIndex < 0 then
      RichEdit1.Lines.Add('No file selected')
    else
    begin
      ADoc := WOrg.FileList.ActiveFile.Selected;
      if VarIsEmpty(ADoc) then
        RichEdit1.Lines.Add('No document selected')
      else
      if not (ADoc.isTable and WOrg.FileList.ActiveFile.TableExists(ADoc.Ext)) then
        RichEdit1.Lines.Add('Selected document is not a table')
      else
      begin
        FTable := ADoc.Open;
        FItemIndex := 0;
        FCommentIndex := FTable.TableDef.FieldByName('Comments').Index;
        FTitleIndex := FTable.TableDef.FieldByName('Title').Index;
        UpdateData;
      end;
    end;
    ShowModal;
  finally
    if not (VarIsEmpty(FTable) or VarIsNull(FTable)) then
    begin
      FTable := NULL;
      ADoc.Close;
    end;
    Free;
  end;
end;

function StreamToArrayOfByte(Stream: TMemoryStream): Variant;
var
  p: Pointer;
begin
  if Stream.Size > 0 then
  begin
    Result := VarArrayCreate([0, Stream.Size], varByte);
    p := VarArrayLock(Result);
    try
      Stream.Position := 0;
      Stream.Read(p^, Stream.Size);
    finally
      VarArrayUnlock(Result);
      Stream.Position := 0;
    end;
  end
  else
    Result := NULL;
end;

procedure ArrayOfByteToStream(V: Variant; Stream: TMemoryStream);
var
  p: Pointer;
begin
  if not (VarIsEmpty(V) or VarIsNull(V)) then
  begin
    p := VarArrayLock(V);
    try
      Stream.Position := 0;
      Stream.Write(p^, VarArrayHighBound(V, 1));
      Stream.Position := 0;
    finally
      VarArrayUnlock(V);
    end;
  end;
end;

function GetTempFolder: String;
var
  i: Integer;
begin
  i := GetTempPath(0, nil);
  SetLength(Result, i);
  GetTempPath(i, PChar(Result));
  SetLength(Result, StrLen(PChar(Result)));
end;

procedure TfrmComment.UpdateData;
var
  s, s1: String;
  ARec, RVF, V: Variant;
  AStream: TMemoryStream;
begin
  btFirst.Enabled := (FItemIndex <> 0);
  btPrev.Enabled := btFirst.Enabled;
  btLast.Enabled := FItemIndex < (FTable.Count - 1);
  btNext.Enabled := btLast.Enabled;

  s := '';
  if FItemIndex < FTable.Count then
  begin
    ARec := FTable.Items[FItemIndex].Open;
    try
      if not ARec.isNull(FTitleIndex) then
        s := ARec.Values[FTitleIndex];

      if not ARec.isNull(FCommentIndex) then
      begin
        V := ARec.Values[FCommentIndex];

        RVF := CreateOLEObject('WinOrganizer.RVF');
        try
          AStream := TMemoryStream.Create;
          try
            //ArrayOfByteToStream(VRTF, AStream);
            case rgFormat.ItemIndex of
              0: //RTF
                begin
                  ArrayOfByteToStream(RVF.RVFToRTF(V), AStream);
                  RichEdit1.Lines.LoadFromStream(AStream);
                end;
              1: //TXT
                begin
                  RichEdit1.Lines.Text := WideString(RVF.RVFToTXT(V))
                end;
              2: //RVF
                begin
                  ArrayOfByteToStream(V, AStream);
                  RichEdit1.Lines.LoadFromStream(AStream);
                end;
              3: //HTML
                begin
                  s1 := GetTempFolder + 'test.html';
                  RVF.RVFToHtmlFile(V, s1);
                  RichEdit1.Lines.LoadFromFile(s1);
                  s := s + s1;
                end;
            end;

          finally
            AStream.Free;
          end;
        finally
          RVF := NULL;
        end;
      end
      else
        RichEdit1.Lines.Clear;
    finally
      FTable.Items[FItemIndex].Close;
    end;
  end;

  PanelTitle.Caption := s;
end;

procedure TfrmComment.btNavigatorClick(Sender: TObject);
begin
  if Sender = btFirst then
    FItemIndex := 0
  else
  if Sender = btPrev then
    Dec(FItemIndex)
  else
  if Sender = btNext then
    Inc(FItemIndex)
  else
  if Sender = btLast then
    FItemIndex := FTable.Count - 1;

  UpdateData;
end;

procedure TfrmComment.rgFormatClick(Sender: TObject);
begin
  RichEdit1.Lines.Clear;
  RichEdit1.PlainText := (rgFormat.ItemIndex <> 0);
  UpdateData;
end;

procedure TfrmComment.btSaveClick(Sender: TObject);
var
  ARec, RVF, V: Variant;
  AStream: TMemoryStream;
  S: WideString;
begin
  if FItemIndex < FTable.Count then
  begin
    ARec := FTable.Items[FItemIndex].Open;
    try
      if not ARec.isNull(FCommentIndex) then
      begin
        V := ARec.Values[FCommentIndex];

        RVF := CreateOLEObject('WinOrganizer.RVF');
        try
          AStream := TMemoryStream.Create;
          try
            SaveDialog1.FileName := ChangeFileExt(SaveDialog1.FileName, '');

            case rgFormat.ItemIndex of
              0: //RTF
                begin
                  SaveDialog1.Filter := 'RTF files (*.rtf)|*.rtf';
                  SaveDialog1.DefaultExt := '.rtf';
                end;
              1: //TXT
                begin
                  SaveDialog1.Filter := 'TXT files (*.txt)|*.txt';
                  SaveDialog1.DefaultExt := '.txt';
                end;
              2: //RVF
                begin
                  SaveDialog1.Filter := 'RVF files (*.rvf)|*.rvf';
                  SaveDialog1.DefaultExt := '.rvf';
                end;
              3: //HTML
                begin
                  SaveDialog1.Filter := 'HTML files (*.htm)|*.htm';
                  SaveDialog1.DefaultExt := '.htm';
                end;
            end;

            if SaveDialog1.Execute then
              case rgFormat.ItemIndex of
                0: //RTF
                  begin
                    ArrayOfByteToStream(RVF.RVFToRTF(V), AStream);
                    AStream.SaveToFile(SaveDialog1.FileName);
                  end;
                1: //TXT
                  begin
                    S := WideString(RVF.RVFToTXT(V));
                    AStream.Write(S[1], Length(S));
                    AStream.SaveToFile(SaveDialog1.FileName);
                  end;
                2: //RVF
                  begin
                    ArrayOfByteToStream(V, AStream);
                    AStream.SaveToFile(SaveDialog1.FileName);
                  end;
                3: //HTML
                  begin
                    RVF.RVFToHtmlFile(V, SaveDialog1.FileName);
                  end;
              end;

          finally
            AStream.Free;
          end;
        finally
          RVF := NULL;
        end;
      end
      else
        RichEdit1.Lines.Clear;
    finally
      FTable.Items[FItemIndex].Close;
    end;
  end;

end;

procedure TfrmComment.btImportHtml(Sender: TObject);
var
  ARec, RVF, V: Variant;
  AStream: TMemoryStream;
  S: WideString;
begin
{
  if FItemIndex < FTable.Count then
  begin
    ARec := FTable.Items[FItemIndex].Open;
    try
      RVF := CreateOLEObject('WinOrganizer.RVF');
      try
        V := RVF.HtmlFileToRVF('c:\test.html');
        ARec.Values[FCommentIndex] := V;
      finally
        RVF := NULL;
      end;

    finally
      FTable.Items[FItemIndex].Close;
    end;
  end;
}
end;

end.